An Invitation to the Roland World of Music

home *** CD-ROM | disk | FTP | other *** search

/ An Invitation to the Roland World of Music / Roland - An Invitation To The Roland World Of Music.bin / vb / cooltool / filter / filter.frm next >

Wrap

Text File | 1995-04-20 | 28KB | 868 lines

VERSION 2.00 Begin Form FormFilter BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "MIDI In Filtering" Height = 7140 Icon = FILTER.FRX:0000 Left = 1950 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6735 ScaleWidth = 5010 Top = 90 Width = 5130 Begin MIDIOutput MIDIOutput1 DeviceID = 0 Left = 2250 Top = 0 VolumeLeft = 0 VolumeRight = 0 End Begin MIDIInput MIDIInput1 DeviceID = 0 Left = 2310 MaxSysexSize = 0 MessageEventEnable= -1 'True Top = 1170 End Begin Frame Frame7 BackColor = &H00C0C0C0& Caption = "MIDI Channel" Height = 2385 Left = 90 TabIndex = 32 Top = 3480 Width = 2415 Begin Knob Knob1 BackColor = &H00C0C0C0& BevelWidth = 3 BorderWidth = 2 FontBold = 0 'False FontItalic = 0 'False FontName = "Small Fonts" FontSize = 6.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 1845 Indicator = 1 'Line IndicatorColor = &H00FFFFFF& IndicatorWidth = 1 KnobColor = &H00404040& KnobStyle = 1 'Raised Left = 180 LinkControl = "" LinkProperty = "" Max = 15 Min = 0 Radius = 525 TickCaptionColor= &H00000000& TickCaptions = FILTER.FRX:0302 TickColor = &H00FFFFFF& TickCount = 16 TickGap = 3 TickLength = 9 TickWidth = 1 Top = 360 Value = 0 Width = 2085 End End Begin Frame Frame6 BackColor = &H00C0C0C0& Caption = "Channel Filtering" ForeColor = &H00000000& Height = 2055 Left = 90 TabIndex = 24 Top = 1410 Width = 2415 Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Pitch Bend" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 6 Left = 330 TabIndex = 31 Top = 1710 Width = 1605 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Channel Pressure" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 5 Left = 330 TabIndex = 30 Top = 1470 Width = 1605 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Note On" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 0 Left = 330 TabIndex = 29 Top = 270 Width = 1425 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Note Off" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 1 Left = 330 TabIndex = 28 Top = 510 Width = 1425 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Key Pressure" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 2 Left = 330 TabIndex = 27 Top = 750 Width = 1425 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Control Change" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 3 Left = 330 TabIndex = 26 Top = 990 Width = 1425 End Begin CheckBox CheckMIDIFilterChannel BackColor = &H00C0C0C0& Caption = "Program Change" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 225 Index = 4 Left = 330 TabIndex = 25 Top = 1230 Width = 1605 End End Begin Frame Frame5 BackColor = &H00C0C0C0& Caption = "Real-Time Filtering" Height = 2385 Left = 2550 TabIndex = 15 Top = 3480 Width = 2415 Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "MIDI Continue" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 3 Left = 150 TabIndex = 23 Top = 1050 Width = 1575 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "MIDI Stop" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 4 Left = 150 TabIndex = 22 Top = 1290 Width = 1635 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "Undefined" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 5 Left = 150 TabIndex = 21 Top = 1530 Width = 1425 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "Active Sensing" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 6 Left = 150 TabIndex = 20 Top = 1770 Width = 1425 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "System Reset" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 7 Left = 150 TabIndex = 19 Top = 2010 Width = 1425 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "MIDI Clock" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 0 Left = 150 TabIndex = 18 Top = 330 Width = 1425 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "Undefined" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 1 Left = 150 TabIndex = 17 Top = 570 Width = 1425 End Begin CheckBox CheckMIDIFilterReal BackColor = &H00C0C0C0& Caption = "MIDI Start" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 2 Left = 150 TabIndex = 16 Top = 810 Width = 1425 End End Begin Frame Frame4 BackColor = &H00C0C0C0& Caption = "Queued MIDI Messages" Height = 585 Left = 60 TabIndex = 7 Top = 750 Width = 4905 Begin Label LblInQueueCount Alignment = 2 'Center BackColor = &H00000000& Caption = "MIDI In Queue Count" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FF00& Height = 225 Left = 90 TabIndex = 9 Top = 270 Width = 4755 End End Begin Frame Frame3 BackColor = &H00C0C0C0& Caption = "MIDI Message" Height = 585 Left = 60 TabIndex = 6 Top = 120 Width = 4905 Begin Label LblMidiMessage Alignment = 2 'Center BackColor = &H00000000& Caption = "MIDI Message" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FF00& Height = 225 Left = 90 TabIndex = 8 Top = 270 Width = 4755 End End Begin Frame Frame2 BackColor = &H00C0C0C0& Caption = "MIDI Filtering" Height = 2055 Left = 2550 TabIndex = 4 Top = 1410 Width = 2415 Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "Tune Request" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 5 Left = 120 TabIndex = 14 Top = 1500 Width = 1425 End Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "Undefined xF5" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 4 Left = 120 TabIndex = 13 Top = 1260 Width = 1425 End Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "Undefined xF4" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 3 Left = 120 TabIndex = 12 Top = 1020 Width = 1425 End Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "Song Select" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 2 Left = 120 TabIndex = 11 Top = 780 Width = 1425 End Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "Song Position Pointer" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 1 Left = 120 TabIndex = 10 Top = 540 Width = 1935 End Begin CheckBox CheckMIDIFilter BackColor = &H00C0C0C0& Caption = "MIDI Time Code" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 225 Index = 0 Left = 120 TabIndex = 5 Top = 300 Width = 1755 End End Begin Frame Frame1 BackColor = &H00C0C0C0& Caption = "MIDI Out" Height = 675 Left = 2550 TabIndex = 2 Top = 5940 Width = 2415 Begin ComboBox Combo1 Height = 300 Left = 120 Style = 2 'Dropdown List TabIndex = 3 Top = 270 Width = 2205 End End Begin Frame FrameMidiIn BackColor = &H00C0C0C0& Caption = "MIDI In" Height = 675 Left = 90 TabIndex = 0 Top = 5940 Width = 2415 Begin ComboBox Combo2 Height = 300 Left = 120 Style = 2 'Dropdown List TabIndex = 1 Top = 270 Width = 2205 End End End Option Explicit ' ' This FILTER example program was developed to show the types of ' MIDI message filtering that can be done with MIDI CoolTools. ' ' Remember that Channel Filtering is MIDI Channel specific. Example: ' You could filter note off events on MIDI Channel 2, but allow them ' to not be filter on MIDI Channel 1 ' MIDIInput1.Filter(NOTE_OFF + Channel1) = False ' MIDIInput1.Filter(NOTE_OFF + Channel2) = True ' ' ' Look in the MIDCONST.BAS for MIDI filtering constants ' Sub CheckMIDIFilter_Click (index As Integer) Select Case index Case Is = 0 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_MTC) = False Else MIDIInput1.Filter(FILTER_MTC) = True End If Case Is = 1 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_SNGPTR) = False Else MIDIInput1.Filter(FILTER_SNGPTR) = True End If Case Is = 2 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_SNGSEL) = False Else MIDIInput1.Filter(FILTER_SNGSEL) = True End If Case Is = 3 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_F4) = False Else MIDIInput1.Filter(FILTER_F4) = True End If Case Is = 4 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_F5) = False Else MIDIInput1.Filter(FILTER_F5) = True End If Case Is = 5 If CheckMIDIFilter(index).Value = 0 Then MIDIInput1.Filter(FILTER_TUNE) = False Else MIDIInput1.Filter(FILTER_TUNE) = True End If End Select End Sub Sub CheckMIDIFilter1_Click (Value As Integer) If Value = 0 Then MIDIInput1.Filter(FILTER_F9) = False Else MIDIInput1.Filter(FILTER_F9) = True End If End Sub Sub CheckMIDIFilter2_Click (Value As Integer) If Value = 0 Then MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = False Else MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = True End If End Sub Sub CheckMIDIFilter3_Click (Value As Integer) If Value = 0 Then MIDIInput1.Filter(FILTER_CLOCK) = False Else MIDIInput1.Filter(FILTER_CLOCK) = True End If End Sub Sub CheckMIDIFilterChannel_Click (index As Integer) Select Case index Case Is = 0 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(NOTE_ON + Knob1.Value) = False Else MIDIInput1.Filter(NOTE_ON + Knob1.Value) = True End If Case Is = 1 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = False Else MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = True End If Case Is = 2 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = False Else MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = True End If Case Is = 3 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = False Else MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = True End If Case Is = 4 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = False Else MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = True End If Case Is = 5 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = False Else MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = True End If Case Is = 6 If CheckMIDIFilterChannel(index).Value = 0 Then MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = False Else MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = True End If End Select End Sub Sub CheckMIDIFilterReal_Click (index As Integer) Select Case index Case Is = 0 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_CLOCK) = False Else MIDIInput1.Filter(FILTER_CLOCK) = True End If Case Is = 1 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_F9) = False Else MIDIInput1.Filter(FILTER_F9) = True End If Case Is = 2 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_START) = False Else MIDIInput1.Filter(FILTER_START) = True End If Case Is = 3 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_CONT) = False Else MIDIInput1.Filter(FILTER_CONT) = True End If Case Is = 4 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_STOP) = False Else MIDIInput1.Filter(FILTER_STOP) = True End If Case Is = 5 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_FD) = False Else MIDIInput1.Filter(FILTER_FD) = True End If Case Is = 6 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = False Else MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = True End If Case Is = 7 If CheckMIDIFilterReal(index).Value = 0 Then MIDIInput1.Filter(FILTER_RESET) = False Else MIDIInput1.Filter(FILTER_RESET) = True End If End Select End Sub Sub Combo1_Click () Dim wRtn As Integer ' Close MIDIOutput1.Action = MIDIOUT_CLOSE ' Open selected device MIDIOutput1.DeviceID = Combo1.ListIndex - 1 MIDIOutput1.Action = MIDIOUT_OPEN End Sub Sub Combo2_Click () Dim wRtn As Integer If MIDIInput1.State >= MIDISTATE_OPEN Then ' Close midiin port MIDIInput1.Action = MIDIIN_CLOSE End If ' Get selected device id MIDIInput1.DeviceID = Combo2.ListIndex ' Open and display handle MIDIInput1.Action = MIDIIN_OPEN MIDIInput1.Action = MIDIIN_START End Sub Sub Form_Load () Dim i As Integer ' Center the form on the screen 'Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 ' ' Fill output device combo box ' For i = -1 To MIDIOutput1.DeviceCount - 1 MIDIOutput1.DeviceID = i Combo1.AddItem MIDIOutput1.ProductName Next ' ' Select first in list ' Combo1.ListIndex = 0 MIDIOutput1.DeviceID = -1 ' ' Fill input device combo box ' For i = 0 To MIDIInput1.DeviceCount - 1 MIDIInput1.DeviceID = i Combo2.AddItem MIDIInput1.ProductName Next ' ' Select first in list ' Combo2.ListIndex = 0 MIDIInput1.DeviceID = 0 End Sub Sub Form_Unload (Cancel As Integer) MIDIInput1.Action = MIDIIN_STOP ' Close midiin port MIDIInput1.Action = MIDIIN_CLOSE ' Close MIDIOutput1.Action = MIDIOUT_CLOSE End Sub Sub Knob1_Change () Dim index As Integer ' 'Turn off all Filter on this channel ' For index = 0 To 6 CheckMIDIFilterChannel(index).Value = 0 MIDIInput1.Filter(NOTE_ON + Knob1.Value) = False MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = False MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = False MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = False MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = False MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = False MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = False Next End Sub Sub MIDIInput1_Error (ErrorCode As Integer, ErrorMessage As String) ' ' Midi input error, display message ' MsgBox ErrorMessage End Sub Sub MIDIInput1_Message () ' ' Show incoming data on screen ' Labels in VB 3.0 are very slow in updating/repainting, ' at least in terms of real-time. If you using a label REFRESH ' method you will experience some time delay. ' ' Generally, painting of a label control is handled automatically ' by VB while no events are occurring. So if you try to force ' VB to repaint a label control immediately, you will be taking ' LblMidiMessage.Caption = Str(MIDIInput1.Message) & Str(MIDIInput1.Data1) & Str(MIDIInput1.Data2) ' 'This do while loop allows you to take all the messages that are 'waiting in the message queue. ' Do While MIDIInput1.MessageCount > 0 ' 'This is the incoming MIDI data ' MIDIOutput1.Message = MIDIInput1.Message MIDIOutput1.Data1 = MIDIInput1.Data1 MIDIOutput1.Data2 = MIDIInput1.Data2 MIDIOutput1.Time = 0 ' ' Display number of queued MIDI In messages ' LblInQueueCount.Caption = MIDIInput1.MessageCount LblInQueueCount.Refresh ' 'Send MIDI Data ' MIDIOutput1.Action = MIDIOUT_SEND ' 'Remove the MIDI data from the MIDI IN queue ' MIDIInput1.Action = MIDIIN_REMOVE Loop End Sub Sub MIDIOutput1_Error (ErrorCode As Integer, ErrorMessage As String) ' ' Midi output error, display message ' MsgBox ErrorMessage End Sub Sub MIDIOutput1_QueueEmpty () ' 'Once queue becomes empty, get ready to record again ' MIDIOutput1.Action = MIDIOUT_STOP End Sub